perm filename UNBRAC.1[AID,LSP] blob
sn#265940 filedate 1977-02-17 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (declare (fixnum i cnt n))
C00004 ENDMK
C⊗;
(declare (fixnum i cnt n))
(macrodef select-disk (x)
((lambda (↑R ↑W ↑Q eof linel)
x) t t t -1 132))
(macrodef push (x y)
(setq y (cons x y)))
(macrodef pop (x y)
(setq x (car y)
y (cdr y)))
(macrodef incr (n)
(setq n (1+ n)))
(macrodef dcr (n)
(setq n (1- n)))
(macrodef set-one (n)
(setq n 1))
(macrodef write (n)
(do ((i n (1- i))) ((zerop i))
(tyo 51)))
(defun unbracket fexpr (file)
(prog (pdl cnt)
(setq cnt 0)
(apply 'eread file)
(uwrite)
(select-disk
(do ((i (tyi eof)(tyi eof)))
((= i eof))
(cond ((or (= i 15)(= i 12)) (terpri)(tyi))
((= i 133)
(push cnt pdl)
(set-one cnt)
(tyo 50))
((= i 135)
(write cnt)
(pop cnt pdl))
((= i 50)
(incr cnt) (tyo i))
((= i 51) (dcr cnt) (tyo i))
((= i 32)(tyo 73)(tyo 73))
((= i 42)(tyo 174))
((= i 100)(tyo 47))
(t (tyo i)))))
(return (apply 'ufile (list (car file) 'mcl)))))